{-# LANGUAGE ViewPatterns #-}
{- generates the Lambdabot.Plugin.Misc.Dummy.DocAssocs -}
module Main where

import Text.HTML.TagSoup
import Data.List.Split
import Text.PrettyPrint
import qualified Data.Map as M
import qualified Data.Set as S
import Data.List
import Data.Char
import Network.Curl

main = do
    (CurlOK, s) <-
        curlGetString "http://www.haskell.org/ghc/docs/latest/html/libraries/index.html" []
    let ts = parseTags s
    let das = [(map toDot mod, intercalate "-" pkg)
                | TagOpen "a" [("href", splitOn "/" ->
                                [(init2 . splitOn "-" -> pkg ) ,
                                 stripSuffix ".html" -> Just mod])] <- ts,
                  any isUpper mod ]
        uniq = 
            M.fromList
            $ zipWith (flip (,)) [1 :: Int .. ]
            $ S.toList $ S.fromList $ map snd das

    print $ text header
            $+$ ppPkgs (M.toList uniq)
            $+$ ppAssocs uniq das

toDot '-' = '.'
toDot x = x

init2 xs = reverse . drop 1 . reverse $ xs

stripSuffix a = fmap reverse . stripPrefix (reverse a) . reverse

ppPkgs das = vcat $ map ppPkg das

ppPkg (c, i) =
    v i <+> text ":: P.ByteString" $$
    v i <+> equals <+> text "P.pack" <+> doubleQuotes (text c)

v i = text "v" <> int i

ppAssocs u das =
     text "docAssocs :: M.Map P.ByteString (P.ByteString, P.ByteString)" $$
     hang (text "docAssocs = {-# SCC \"Dummy.DocAssocs\" #-} M.fromList")
                    2
        (brackets $ vcat $ punctuate comma $ map (ppAssoc u) das)

ppAssoc u (a,b) = let Just i = M.lookup b u in
        parens $ text "P.pack" <+> doubleQuotes (text (map toLower a))
            <+> comma <+> parens (text "P.pack" <+> doubleQuotes (text a)
                                    <> comma <+> v i)

header =
   "-- autogenerated\n\
    \module Lambdabot.Plugin.Misc.Dummy.DocAssocs (docAssocs) where\n\
    \import qualified Data.Map as M\n\
    \import qualified Data.ByteString.Char8 as P"

